home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0034_Detect Float Error.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  18KB  |  804 lines
  1. {
  2. GERD KORTEMEYER
  3.  
  4. here are two Units For trapping float-exceptions. In your Program you
  5. will have to add
  6.  
  7.   Uses err387
  8.  
  9. and at the beginning of your main Program say For example
  10.  
  11. begin
  12.    exception(overflow, masked);
  13.    exception(underflow, dumpask);
  14.    exception(invalid, dumpexit);
  15.    autocorrect(zerodiv, 1.0);
  16.    exception(precision, masked);
  17.  
  18. In this way you can choose For any kind of exception in which way it is
  19. to be handeled. After the lines above the result of a division by zero
  20. will be '1.0', in Case of an underflow there will be a dump of the copro
  21. and the user will be asked For the result he wants the operation to have,
  22. in Case of an overflow the largest available number will be chosen and
  23. so on ...
  24.  
  25. Here are the Units
  26.  
  27.     err387 and dis387
  28. }
  29.  
  30. { ---------------------------------------------------------- }
  31. { Fehlerbehandlungsroutinen fuer den Intel 80387 bzw. 486 DX }
  32. { Geschrieben in Turbo Pascal 6.0                            }
  33. { von Gerd Kortemeyer, Hannover                              }
  34. { ---------------------------------------------------------- }
  35.  
  36. Unit err387;
  37.  
  38. Interface
  39.  
  40. Uses
  41.   dis387, Dos, Crt;
  42.  
  43. Const
  44.   invalid   = 1;
  45.   denormal  = 2;
  46.   zero_div  = 4;
  47.   overflow  = 8;
  48.   underflow = 16;
  49.   precision = 32;
  50.   stackfault= 64;
  51.   con1      = 512;
  52.  
  53.   masked    = 0;
  54.   runtime   = 1;
  55.   dump      = 2;
  56.   dumpexit  = 3;
  57.   dumpask   = 4;
  58.   autocorr  = 5;
  59.  
  60.  
  61. Procedure exception(which, what : Word);
  62. Procedure autocorrect(which : Word; by : Extended);
  63.  
  64. Procedure handle_off;
  65. Procedure handle_on;
  66.  
  67. Procedure restore_masks;
  68.  
  69. Procedure clear_copro;
  70. Function  status_Word : Word;
  71.  
  72. Var
  73.   do_again : Word;
  74.  
  75. Implementation
  76.  
  77. Const
  78.   valid = 0;
  79.   zero  = 1;
  80.   spec  = 2;
  81.   empty = 3;
  82.  
  83.   topmask : Word = 14336;
  84.   topdiv  = 2048;
  85.  
  86.   anyerrors : Word = 63;
  87.  
  88.   zweipot : Array [0..15] of Word =
  89.     (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024,
  90.      2048, 4096, 8192, 16384, 32768);
  91.  
  92.   ex_nam : Array[0..5] of String=
  93.     ('Invalid   ',
  94.      'Denormal  ',
  95.      'Zero-Div  ',
  96.      'Overflow  ',
  97.      'Underflow ',
  98.      'Precision ');
  99.  
  100. Var
  101.   setmasks : Byte;
  102.   normal   : Record
  103.     Case Boolean OF
  104.       True : (adr : Pointer);
  105.       False: (pro : Procedure);
  106.     end;
  107.  
  108.   Exit_on,
  109.   dump_on,
  110.   ask_on,
  111.   auto_on,
  112.   standard : Word;
  113.  
  114.   auto_val : Array [0..5] of Extended;
  115.  
  116. Procedure Mask(which : Word);
  117. Var
  118.   cw : Word;
  119. begin
  120.   Asm
  121.     fstcw cw
  122.   end;
  123.   cw := cw or which;
  124.   setmasks := Lo(cw);
  125.   Asm
  126.     fldcw cw
  127.   end;
  128. end;
  129.  
  130. Procedure Unmask(which : Word);
  131. Var
  132.   cw : Word;
  133. begin
  134.   Asm
  135.     fclex
  136.     fstcw cw
  137.   end;
  138.   cw := cw and not (which);
  139.   setmasks := Lo(cw);
  140.   Asm
  141.     fldcw cw
  142.   end;
  143. end;
  144.  
  145. Procedure restore_masks;
  146. Var
  147.   setm : Word;
  148.   i    :Integer;
  149. begin
  150.   setm:=setmasks;
  151.   For i := 0 to 5 do
  152.     if (setm and zweipot[i]) <> 0 then
  153.       Mask  (zweipot[i])
  154.     else
  155.       Unmask(zweipot[i]);
  156. end;
  157.  
  158. Procedure clear_copro;
  159. Var
  160.   cw : Word;
  161. begin
  162.   Asm
  163.     fstcw cw
  164.   end;
  165.   setmasks := Lo(cw);
  166.   Asm
  167.     finit
  168.   end;
  169. end;
  170.  
  171. Function status_Word;
  172. begin
  173.   Asm
  174.     fstsw @result
  175.   end;
  176. end;
  177.  
  178. { Bei welcher Exception soll was passieren? }
  179. Procedure exception;
  180. begin
  181.   Case what OF
  182.  
  183.     masked  : Mask(which);
  184.  
  185.     runtime :
  186.       begin
  187.         Unmask(which);
  188.         standard := standard or which;
  189.       end;
  190.  
  191.     dump :
  192.       begin
  193.         Unmask(which);
  194.         standard := standard and NOT(which);
  195.         dump_on  := dump_on  or  which;
  196.         Exit_on  := Exit_on  and NOT(which);
  197.         ask_on   := ask_on   and NOT(which);
  198.         auto_on  := auto_on  and NOT(which);
  199.       end;
  200.  
  201.     dumpexit :
  202.       begin
  203.         Unmask(which);
  204.         standard := standard and NOT(which);
  205.         dump_on  := dump_on  or  which;
  206.         Exit_on  := Exit_on  or  which;
  207.         ask_on   := ask_on   and NOT(which);
  208.         auto_on  := auto_on  and NOT(which);
  209.       end;
  210.  
  211.     dumpask :
  212.       begin
  213.         Unmask(which);
  214.         standard := standard and NOT(which);
  215.         dump_on  := dump_on  or  which;
  216.         Exit_on  := Exit_on  and NOT(which);
  217.         ask_on   := ask_on   or  which;
  218.         auto_on  := auto_on  and NOT(which);
  219.       end;
  220.    end;
  221. end;
  222.  
  223. { zum Setzen von Auto-Korrekt-Werten }
  224.  
  225. Procedure autocorrect;
  226. Var
  227.   i : Integer;
  228. begin
  229.    Unmask(which);
  230.    standard := standard and NOT(which);
  231.    dump_on  := dump_on  and NOT(which);
  232.    Exit_on  := Exit_on  and NOT(which);
  233.    ask_on   := ask_on   and NOT(which);
  234.    auto_on  := auto_on  or  which;
  235.    For i := 0 to 5 do
  236.      if (which and zweipot[i]) <> 0 then
  237.        auto_val[i] := by;
  238. end;
  239.  
  240. { ------------- Die Interrupt-Routine selbst ------------- }
  241.  
  242. Procedure errorcon; Interrupt;
  243. Var
  244.   copro : Record
  245.     control_Word,
  246.     status_Word,
  247.     tag_Word, op,
  248.     instruction_Pointer,
  249.     ip, operand_Pointer, : Word;
  250.     st                   : Array [0..7] of Extended;
  251.   end;
  252.  
  253.   top : Integer; { welches Register ist Stacktop? }
  254.  
  255.   masked,            { welche Exceptions maskiert? }
  256.   occured : Byte;    { welche Exceptions aufgetreten? }
  257.  
  258.   opcode  : Word;
  259.  
  260.   inst_seg,       { Instruction-Pointer, Segment }
  261.   inst_off,       { "                  , Offset  }
  262.   oper_seg,       { Operand-Pointer    , Segment }
  263.   oper_off: Word; { "                  , Offset  }
  264.  
  265.   inst_point : ^Word;                 { zum Adressieren des Opcodes }
  266.  
  267.   oper_point : Record
  268.     Case Integer of { zum Adressieren des Operanden }
  269.       1 : (ex : ^Extended);
  270.       2 : (db : ^Double);
  271.       3 : (si : ^Single);
  272.       4 : (co : ^Comp);
  273.     end;
  274.  
  275.   marker: Array [0..7] of Word; { Register-Marker nach Tag-Word }
  276.  
  277.   opt_dump,               { soll ausgeben werden? }
  278.   opt_exit,               { soll aufgehoert werden? }
  279.   opt_ask,                { soll Ergebnis abgefragt werden? }
  280.   opt_auto  : Boolean;    { soll Ergebnis automatisch korrigiert werden? }
  281.  
  282.   i         : Integer;
  283.  
  284.   mem_access: Boolean;    { gibt es Speicherzugriff? }
  285.  
  286.   op_name   : String;     { Mnemonik des Befehls }
  287.  
  288. { Ersetze Stacktop durch abgefragten Wert }
  289. Procedure ask_correct;
  290. Var
  291.   res  : Extended;
  292.   ch   : Char;
  293.   t    : String;
  294.   code : Integer;
  295. begin
  296.    Asm
  297.      fstp res
  298.    end;
  299.    WriteLN;
  300.    Write('The result would be ', res, '. Change? (y/n) ' );
  301.    Repeat
  302.      Repeat Until KeyPressed;
  303.      ch := ReadKey;;
  304.    Until ch in ['Y','y','N','n'];
  305.    Writeln;
  306.    if ch in ['Y','y'] then
  307.    Repeat
  308.      Write('New value : ');
  309.      READLN(t);
  310.      VAL(t, res, code);
  311.    Until code = 0;
  312.    Asm
  313.      fld res
  314.    end;
  315. end;
  316.  
  317. Function hex(w : Word) : String; { Ausgabe als HeX-Zahl }
  318. Const
  319.   zif : Array [0..15] of Char = ('0','1','2','3','4','5','6','7','8','9',
  320.                                     'a','b','c','d','e','f');
  321. begin
  322.   hex := zif[w div zweipot[12]] +
  323.          zif[(w MOD zweipot[12]) div zweipot[8]] +
  324.          zif[(w MOD zweipot[8]) div zweipot[4]] +
  325.          zif[w MOD zweipot[4]];
  326. end;
  327.  
  328. Procedure choice;
  329. Var
  330.   ch : Char;
  331. begin
  332.   WriteLN;
  333.   Write('C)ontinue, A)bort ');
  334.   Repeat
  335.     Repeat Until KeyPressed;
  336.     ch:=ReadKey;;
  337.     if ch in ['A','a'] then
  338.       Halt(0);
  339.   Until ch in ['C','c'];
  340.   WriteLN;
  341. end;
  342.  
  343. Procedure showcopro; { Ausgeben des FSAVE - Records }
  344. Var
  345.   i : Integer;
  346. begin
  347.   TextMode(LastMode);
  348.   HighVideo;
  349.   WriteLN('Floating point exception, last opcode: ',hex(opcode),
  350.                                                ' (',op_name,')');
  351.   NormVideo;
  352.   WriteLN('Instruction Pointer : ',hex(inst_seg),':',hex(inst_off),
  353.           ' (',hex(inst_point^),')');
  354.   if mem_access then
  355.   begin
  356.     WriteLN('Operand Pointer     : ',hex(oper_seg),':',hex(oper_off));
  357.     WriteLN('( Extended: ',oper_point.ex^,', Double: ',oper_point.db^);
  358.     WriteLN('  Single  : ',oper_point.si^,', Comp  : ',oper_point.co^,' )');
  359.   end
  360.   else
  361.   begin
  362.     WriteLN;
  363.     WriteLN ('No memory access');
  364.     WriteLN;
  365.   end;
  366.   HighVideo;
  367.   if (occured and stackfault) = 0 then
  368.   begin
  369.     WriteLN('Exception ','Masked':8,'Occured':8,'Should be masked':18);
  370.     NormVideo;
  371.     For i:=0 to 5 do
  372.       WriteLN(ex_nam[i], (masked   and zweipot[i]) <> 0 : 8,
  373.                          (occured  and zweipot[i]) <> 0 : 8,
  374.                          (setmasks and zweipot[i]) <> 0 : 18);
  375.     HighVideo;
  376.   end
  377.   else
  378.   begin
  379.     WriteLN('Invalid Operation:');
  380.     if (copro.status_Word and con1) <> 0 then
  381.       WriteLN('                       -- Stack Overflow --')
  382.     else
  383.       WriteLN('                       -- Stack Underflow --');
  384.     WriteLN;
  385.   end;
  386.  
  387.   WriteLN('Reg  ','Value':29,'Marked':10);
  388.   Normvideo;
  389.   For i := 0 to 7 do
  390.   begin
  391.     Write('st(',i,')', copro.st[i] : 29);
  392.     Case marker[i] OF
  393.        valid : WriteLN('Valid'   : 10);
  394.        spec  : WriteLN('Special' : 10);
  395.        empty : WriteLN('Empty'   : 10);
  396.        zero  : WriteLN('Zero'    : 10);
  397.     end;
  398.   end;
  399. end;
  400.  
  401. { Ersetze Stacktop durch Auto-Korrekt-Wert }
  402.  
  403. Procedure auto_corr;
  404. Var
  405.   res : Extended;
  406.   i   : Integer;
  407. begin
  408.   Asm
  409.     fstp res
  410.   end;
  411.   For i := 0 to 5 do
  412.     if ((occured and zweipot[i]) <> 0) and
  413.        ((auto_on and zweipot[i]) <> 0) then
  414.       res := auto_val[i];
  415.   Asm
  416.     fld res
  417.   end;
  418. end;
  419.  
  420.  
  421. Procedure do_it_again;
  422. Type
  423.   codearr = Array[0..4] of Byte;
  424. Var
  425.   sam : Record
  426.     Case Boolean OF
  427.       True : (b: ^codearr );
  428.       False: (p: Procedure);
  429.     end;
  430.  
  431.   op_point : Pointer;
  432.   x        : extended;
  433. begin
  434.   New(sam.b);
  435.   sam.b^[0]:=Hi(opcode);
  436.   sam.b^[1]:=Lo(opcode);
  437.   if mem_access then
  438.   begin
  439.   { --- mod r/m auf ds:[di] stellen (00ttt101) --- }
  440.     sam.b^[1] := sam.b^[1] and not (zweipot[7] + zweipot[6] + zweipot[1]);
  441.     sam.b^[1] := sam.b^[1] or (zweipot[2] + zweipot[0]);
  442.   end;
  443.   sam.b^[2] := $ca; { retf 0000 }
  444.   sam.b^[3] := $00;
  445.   sam.b^[4] := $00;
  446.   op_point  := oper_point.ex;
  447.   Asm
  448.     push ds
  449.     lds di, op_point
  450.   end;
  451.  
  452.   sam.p;
  453.  
  454.   Asm
  455.     pop ds
  456.   end;
  457.   Dispose(sam.b);
  458. end;
  459.  
  460. begin
  461.   Asm
  462.     push   ax
  463.     xor    al,al
  464.     out    0f0h,al
  465.     mov    al,020h
  466.     out    0a0h,al
  467.     out    020h,al
  468.     pop    ax
  469.     fsave  copro
  470.   end;
  471.  
  472.   { === Pruefen, ob Bearbeitung durch ERRORCON erwuenscht === }
  473.   if (copro.status_Word and standard) <> 0 then
  474.   begin
  475.     Asm
  476.       frstor copro
  477.     end;
  478.     normal.pro; { Bye, bye ... }
  479.   end;
  480.   { === Auswerten des FSAVE-Records ========================= }
  481.   { --- Opcode wie im Copro gespeichert     --- }
  482.   opcode := zweipot[15] + zweipot[14] + zweipot[12] + zweipot[11] +
  483.             (copro.ip MOD zweipot[11]);
  484.   op_name := dis(opcode);
  485.   mem_access := op_name='...';
  486.   { --- Was war maskiert, was ist passiert? --- }
  487.   masked  := Lo(copro.control_Word);
  488.   occured := Lo(copro.status_Word );
  489.   { --- Der Instruction-Pointer             --- }
  490.   inst_seg := copro.ip and (zweipot[15] + zweipot[14] + zweipot[13] +
  491.                            zweipot[12]);
  492.   inst_off := copro.instruction_Pointer;
  493.   inst_point := Ptr(inst_seg,inst_off);
  494.   { --- Der Operand-Pointer                 --- }
  495.   oper_seg := copro.op and (zweipot[15] + zweipot[14] + zweipot[13] +
  496.                             zweipot[12]);
  497.   oper_off := copro.operand_Pointer;
  498.   oper_point.ex := Ptr(oper_seg,oper_off);
  499.   { --- Wer ist gerade Stacktop? --- }
  500.   top := (copro.status_Word and topmask) div topdiv;
  501.   { --- Einlesen der Marker aus Tag-Word --- }
  502.   For i := 0 to 7 do
  503.   begin
  504.     marker[(8 + i - top) MOD 8] := (copro.tag_Word and (zweipot[i * 2] +
  505.                                     zweipot[i * 2 + 1])) div zweipot[i * 2];
  506.   end;
  507.  
  508.   { --- Welche Aktionen sollen ausgefuehrt werden? --- }
  509.   opt_dump := (copro.status_Word and dump_on) <> 0;
  510.   opt_exit := (copro.status_Word and Exit_on) <> 0;
  511.   opt_ask  := (copro.status_Word and ask_on ) <> 0;
  512.   opt_auto := (copro.status_Word and auto_on) <> 0;
  513.  
  514.   { === Aktionen ============================================ }
  515.   if opt_dump then
  516.     showcopro;
  517.   if opt_exit then
  518.   begin
  519.     WriteLN;
  520.     WriteLN('Exit Program due to Programmers request');
  521.     HALT; { Bye, bye ... }
  522.   end;
  523.   if opt_dump and not (opt_ask) then
  524.     choice;
  525.  
  526.   copro.control_Word := copro.control_Word or anyerrors;
  527.   Asm
  528.     frstor copro
  529.     fclex
  530.   end;
  531.   { --- Befehl nochmals ausfuehren --- }
  532.   if (occured and do_again) <> 0 then
  533.     do_it_again;
  534.   { --- Noch was? --- }
  535.   if opt_auto then
  536.     auto_corr;
  537.   if opt_ask  then
  538.     ask_correct;
  539.   restore_masks;
  540. end;
  541.  
  542. { ------------- Ein- und Ausschalten ------------- }
  543.  
  544. Procedure handle_on;
  545. begin
  546.   Getintvec($75, normal.adr);
  547.   Setintvec($75, @errorcon);
  548. end;
  549.  
  550. Procedure handle_off;
  551. begin
  552.   Setintvec($75, normal.adr);
  553. end;
  554.  
  555. begin
  556.   handle_on;
  557.   dump_on :=0;
  558.   Exit_on :=0;
  559.   ask_on  :=0;
  560.   auto_on :=0;
  561.   standard:=0;
  562.   do_again:=invalid+zero_div+denormal;
  563.   clear_copro;
  564. end.
  565.  
  566.  
  567.  
  568.  
  569.  
  570.  
  571. Unit dis387;
  572.  
  573. Interface
  574.  
  575. Function dis(opco : Word) : String;
  576.  
  577. Implementation
  578.  
  579. Function dis;
  580. Var
  581.   d, op : String;
  582.  
  583.   Procedure opcr(st : Word);
  584.   Var
  585.     t : String;
  586.   begin
  587.     str(st, t);
  588.     op := ' st,st(' + t + ')';
  589.   end;
  590.  
  591.   Procedure opc(st : Word);
  592.   Var
  593.     t : String;
  594.   begin
  595.     str(st, t);
  596.     op := ' st(' + t + '),st';
  597.   end;
  598.  
  599.   Procedure op1(st : Word);
  600.   Var
  601.     t : String;
  602.   begin
  603.     str(st, t);
  604.     op := ' st(' + t + ')';
  605.   end;
  606.  
  607. begin
  608.   d  := '...';
  609.   op := '';
  610.  
  611.   Case Hi(opco) OF
  612.     $d8 :
  613.       Case Lo(opco) div 16 OF
  614.         $c :
  615.           if opco MOD 16 >= 8 then
  616.           begin
  617.             d := 'fmul';
  618.             opcr(opco MOD 16 - 8);
  619.           end
  620.           else
  621.           begin
  622.             d := 'fadd';
  623.             opcr(opco MOD 16);
  624.           end;
  625.  
  626.         $e :
  627.           if opco MOD 16 >= 8 then
  628.           begin
  629.             d := 'fsubr';
  630.             opcr(opco MOD 16 - 8);
  631.           end
  632.           else
  633.           begin
  634.             d := 'fsub';
  635.             opcr(opco MOD 16);
  636.           end;
  637.  
  638.         $f :
  639.           if opco MOD 16 >= 8 then
  640.           begin
  641.             d := 'fdivr';
  642.             opcr(opco MOD 16 - 8);
  643.           end
  644.           else
  645.           begin
  646.             d := 'fdiv';
  647.             opcr(opco MOD 16);
  648.           end;
  649.       end;
  650.  
  651.    $d9 :
  652.      Case Lo(opco) OF
  653.        $d0 : d := 'fnop';
  654.        $e0 : d := 'fchs';
  655.        $e1 : d := 'fabs';
  656.        $e4 : d := 'ftst';
  657.        $e5 : d := 'fxam';
  658.        $e8 : d := 'fld1';
  659.        $e9 : d := 'fld2t';
  660.        $ea : d := 'fld2e';
  661.        $eb : d := 'fldpi';
  662.        $ec : d := 'fldlg2';
  663.        $ed : d := 'fldln2';
  664.        $ee : d := 'fldz';
  665.        $f0 : d := 'f2xm1';
  666.        $f1 : d := 'fyl2x';
  667.        $f2 : d := 'fptan';
  668.        $f3 : d := 'fpatan';
  669.        $f4 : d := 'fxtract';
  670.        $f5 : d := 'fprem1';
  671.        $f6 : d := 'fdecstp';
  672.        $f7 : d := 'fincstp';
  673.        $f8 : d := 'fprem';
  674.        $f9 : d := 'fyl2xp1';
  675.        $fa : d := 'fsqrt';
  676.        $fb : d := 'fsincos';
  677.        $fc : d := 'frndint';
  678.        $fd : d := 'fscale';
  679.        $fe : d := 'fsin';
  680.        $ff : d := 'fcos';
  681.      end;
  682.  
  683.    $db :
  684.      Case Lo(opco) OF
  685.        $e2 : d := 'fclex';
  686.        $e3 : d := 'finit';
  687.      end;
  688.    $dc :
  689.      Case Lo(opco) div 16 OF
  690.        $c :
  691.          if opco MOD 16 >= 8 then
  692.          begin
  693.            d := 'fmul';
  694.            opc(opco MOD 16-8);
  695.          end
  696.          else
  697.          begin
  698.            d := 'fadd';
  699.            opc(opco MOD 16);
  700.          end;
  701.  
  702.        $e : if opco MOD 16 >= 8 then
  703.          begin
  704.            d := 'fsub';
  705.            opc(opco MOD 16 - 8);
  706.          end
  707.          else
  708.          begin
  709.            d := 'fsubr';
  710.            opc(opco MOD 16);
  711.          end;
  712.  
  713.        $f :
  714.          if opco MOD 16 >= 8 then
  715.          begin
  716.            d := 'fdiv';
  717.            opc(opco MOD 16 - 8);
  718.          end
  719.          else
  720.          begin
  721.            d := 'fdivr';
  722.            opc(opco MOD 16);
  723.          end;
  724.      end;
  725.  
  726.    $dd :
  727.      Case Lo(opco) div 16 OF
  728.        $c :
  729.          begin
  730.            d := 'ffree';
  731.            op1(opco MOD 16);
  732.          end;
  733.        $d :
  734.          if opco MOD 16 >= 8 then
  735.          begin
  736.            d := 'fstp';
  737.            op1(opco MOD 16 - 8);
  738.          end
  739.          else
  740.          begin
  741.            d := 'fst';
  742.            op1(opco MOD 16);
  743.          end;
  744.        $e :
  745.          if opco MOD 16 >= 8 then
  746.          begin
  747.            d := 'fucomp';
  748.            op1(opco MOD 16 - 8);
  749.          end
  750.          else
  751.          begin
  752.            d := 'fucom';
  753.            op1(opco MOD 16);
  754.          end;
  755.      end;
  756.  
  757.    $de :
  758.      Case Lo(opco) div 16 OF
  759.        $c :
  760.          if opco MOD 16 >= 8 then
  761.          begin
  762.            d := 'fmulp';
  763.            opc(opco MOD 16 - 8);
  764.          end
  765.          else
  766.          begin
  767.            d := 'faddp';
  768.            opc(opco MOD 16);
  769.          end;
  770.  
  771.        $d : d := 'fcompp';
  772.  
  773.        $e :
  774.          if opco MOD 16 >= 8 then
  775.          begin
  776.            d := 'fsubp';
  777.            opc(opco MOD 16 - 8);
  778.          end
  779.          else
  780.          begin
  781.            d := 'fsubrp';
  782.            opc(opco MOD 16);
  783.          end;
  784.  
  785.        $f :
  786.          if opco MOD 16 >= 8 then
  787.          begin
  788.            d := 'fdivp';
  789.            opc(opco MOD 16 - 8);
  790.          end
  791.          else
  792.          begin
  793.            d := 'fdivrp';
  794.            opc(opco MOD 16);
  795.          end;
  796.      end;
  797.    end;
  798.  
  799.    dis := d + op;
  800. end;
  801.  
  802. begin
  803. end.
  804.